home *** CD-ROM | disk | FTP | other *** search
/ SPACE 1 / SPACE - Library 1 - Volume 1.iso / program / 85 / cpu68.blk < prev    next >
Text File  |  1986-07-13  |  55KB  |  1 lines

  1. \               The Rest is Silence                   30Jun86gem*************************************************************   *************************************************************   ***                                                       ***   ***    Please direct all questions, comments, and         ***   ***    miscellaneous personal abuse to:                   ***   ***                                                       ***   ***    Henry Laxen          or    Michael Perry           ***   ***    1259 Cornell Avenue        1125 Bancroft Way       ***   ***    Berkeley, California       Berkeley, California    ***   ***    94706                      94702                   ***   ***                                                       ***   ***    modified for Atari ST by:  George Morison          ***   ***                               70745,1411  CompuServe  ***   *************************************************************   *************************************************************   \ Load Screen for 68000 Dependent Code                24Jun86gem                                                                warning off                                                     ONLY FORTH ALSO DEFINITIONS   DECIMAL                                                                                              3 LOAD  cr .( The Assembler )                                  18 LOAD  cr .( The Low Level for the Debugger )                 21 LOAD  cr .( The Low Level for the MultiTasker )              24 LOAD  cr .( The Machine Dependent IO words )               CR .( 68000 Machine Dependent Code Loaded )                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                     \ 68000 Assembler Load Screen                         26Jun86gemONLY FORTH ALSO DEFINITIONS                                        1 14 +THRU                                                                                                                   : NEXT   >NEXT bank L#) JMP  ;                                  : INIT    [ ASSEMBLER ] WORD  ;                                 ONLY FORTH ALSO DEFINITIONS                                                                                                     HEX 4EB9 CONSTANT DOES-OP   DECIMAL                             6 CONSTANT DOES-SIZE                                            : DOES?   (S IP -- IP' F )                                         DUP DOES-SIZE + SWAP @ DOES-OP =  ;                                                                                          : LABEL   CREATE  ASSEMBLER  [ ASSEMBLER ] INIT  ;              : CODE    CODE  [ ASSEMBLER ] INIT  ;                                                                                           \ 68000 Assembler                                     06Jan86gemASSEMBLER ALSO DEFINITIONS                                      : A?>MARK      (S -- addr f )   HERE  TRUE  ;                   : A?>RESOLVE   (S addr f -- )                                      ?CONDITION  HERE OVER - SWAP 1- C!  ;                        : A?<MARK      (S -- addr f )   HERE  TRUE  ;                   : A?<RESOLVE   (S addr f -- )                                      ?CONDITION  HERE - HERE 1- C!  ;                                                                                             DEFER C,          FORTH ' C,        ASSEMBLER IS C,             DEFER ,           FORTH ' ,         ASSEMBLER IS ,              DEFER ?>MARK      ' A?>MARK      IS ?>MARK                      DEFER ?>RESOLVE   ' A?>RESOLVE   IS ?>RESOLVE                   DEFER ?<MARK      ' A?<MARK      IS ?<MARK                      DEFER ?<RESOLVE   ' A?<RESOLVE   IS ?<RESOLVE                                                                                   \ 68000 Meta Assembler                                06Jan86gem: C;   END-CODE   ;                                             : ?,   IF , THEN , ;                                            : 2,   , , ;                                                    OCTAL                                                           VARIABLE SIZE                                                   : BYTE  10000 SIZE ! ;                                          : WORD  30100 SIZE ! ; WORD                                     : LONG  24600 SIZE ! ;                                          : SZ   CONSTANT DOES> @ SIZE @ AND OR ;                         00300 SZ SZ3            00400 SZ SZ4                            04000 SZ SZ40           30000 SZ SZ300                          : LONG?   SIZE @ 24600 = ;                                      : -SZ1    LONG? IF  100 OR  THEN ;                                                                                                                                                              \ addressing modes                                    06Jan86gem: REGS   10 0 DO  DUP 1001 I * OR  CONSTANT  LOOP  DROP ;       : MODE    CONSTANT  DOES> @ SWAP 7007 AND OR ;                                                                                  0000 REGS     D0   D1   D2   D3   D4   D5   D6   D7             0110 REGS     A0   A1   A2   A3   A4   A5   A6   A7             0220 MODE     )         ( address register indirect )           0330 MODE     )+        ( adr reg ind post-increment )          0440 MODE     -)        ( adr reg ind pre-decrement )           0550 MODE     D)        ( adr reg ind displaced )               0660 MODE     DI)       ( adr reg ind displaced indexed )       0770 CONSTANT #)        ( immediate address )                   1771 CONSTANT L#)       ( immediate long address )              2772 CONSTANT PCD)      ( PC relative displaced )               3773 CONSTANT PCDI)     ( PC relative displaced indexed )       4774 CONSTANT #         ( immediate data )                      \ fields and register assignments                     06Jan86gem: FIELD   CONSTANT  DOES> @ AND ;                               7000 FIELD RD           0007 FIELD RS                           0070 FIELD MS           0077 FIELD EAS                          0377 FIELD LOW                                                  : DN?   (S ea -- ea flag )  DUP MS 0= ;                         : SRC   (S ea instr -- ea instr' )   OVER EAS OR ;              : DST   (S ea instr -- ea instr' )   SWAP RD  OR ;                                                                              A7 CONSTANT SP   ( Stack pointer )                              A6 CONSTANT RP   ( Return stack pointer )                       A5 CONSTANT IP   ( Interpreter pointer )                        A4 CONSTANT W    ( Working register )                                                                                                                                                                                                                           \ extended addressing                                 06Jan86gem: DOUBLE?  ( mode -- flag )  DUP L#) = SWAP # = LONG? AND OR ;  : INDEX?   ( {n} mode -- {m} mode )                                DUP >R  DUP 0770 AND A0 DI) =  SWAP PCDI) =  OR                 IF   DUP RD 10 * SWAP MS  IF  100000 OR  THEN                        SZ40 SWAP LOW OR                                           THEN  R> ;                                                                                                                   : MORE?   ( ea -- ea flag )  DUP MS 0040 > ;                    : ,MORE   ( ea -- )   MORE?                                        IF  INDEX?  DOUBLE?  ?,  ELSE  DROP  THEN ;                                                                                                                                                                                                                                                                                                                                                  \ extended addressing  extras                         06Jan86gemCREATE EXTRA   HERE 5 DUP ALLOT ERASE \ temporary storage area                                                                  : EXTRA?   ( {n} mode -- mode )   MORE?                             IF  >R  R@ INDEX?  DOUBLE?  EXTRA 1+ SWAP                           IF  2! 2  ELSE  ! 1 THEN  EXTRA C!  R>                      ELSE   0 EXTRA !                                                THEN  ;                                                     : ,EXTRA   ( -- )   EXTRA C@  ?DUP                                 IF   EXTRA 1+ SWAP 1 =                                               IF  @ ,  ELSE  2@ 2,  THEN  EXTRA 5 ERASE                  THEN ;                                                                                                                                                                                                                                                                                                                       \ immediates & address register specific              06Jan86gem: IMM   CONSTANT  DOES> @ >R EXTRA? EAS R> OR SZ3 ,                LONG? ?,  ,EXTRA ;   ( n ea )                                0000 IMM ORI            1000 IMM ANDI                           2000 IMM SUBI           3000 IMM ADDI                           5000 IMM EORI           6000 IMM CMPI                           : IMMSR   CONSTANT  DOES> @ SZ3 2, ; ( n )                      001074 IMMSR ANDI>SR                                            005074 IMMSR EORI>SR                                            000074 IMMSR ORI>SR                                             : IQ   CONSTANT DOES> @ >R  EXTRA?  EAS SWAP RS 1000 * OR          R> OR SZ3 , ,EXTRA ;  ( n ea )                               050000 IQ ADDQ          050400 IQ SUBQ                          : IEAA   CONSTANT  DOES> @ DST SRC SZ4 , ,MORE ; ( ea An )      150300 IEAA ADDA        130300 IEAA CMPA                        040700 IEAA LEA         110300 IEAA SUBA                        \ shifts, rotates, and bit manipulation               06Jan86gem: ISR    CONSTANT  DOES> @ >R DN?                                  IF  SWAP DN? IF  R> 40 OR >R  ELSE DROP SWAP 1000 * THEN            RD SWAP RS OR R> OR 160000 OR SZ3 ,                         ELSE  DUP EAS 300 OR R@ 400 AND OR R> 70 AND 100 * OR                 160000 OR , ,MORE                                         THEN ;  ( Dm Dn ) ( m # Dn ) ( ea )                          400 ISR ASL             000 ISR ASR                             410 ISR LSL             010 ISR LSR                             420 ISR ROXL            020 ISR ROXR                            430 ISR ROL             030 ISR ROR                             : IBIT   CONSTANT  DOES> @ >R  EXTRA?  DN?                         IF  RD SRC 400  ELSE  DROP DUP EAS 4000  THEN                   OR R> OR , ,EXTRA ,MORE ;  ( ea Dn ) ( ea n # )              000 IBIT BTST           100 IBIT BCHG                           200 IBIT BCLR           300 IBIT BSET                           \ branch, loop, and set conditionals                  06Jan86gem: SETCLASS    ' SWAP 0 DO I OVER EXECUTE LOOP DROP ;            : IBRA   400 * 060000 OR CONSTANT    ( label )                            DOES> @ SWAP ?>MARK DROP 2+ - DUP ABS 200 <                     IF  LOW OR ,  ELSE  SWAP 2,  THEN  ;                  20 SETCLASS IBRA   BRA BSR BHI BLS BCC BCS BNE BEQ                                 BVC BVS BPL BMI BGE BLT BGT BLE              : IDBR  400 * 050310 OR CONSTANT    ( label \ Dn - )                      DOES> @ SWAP RS OR , ?>MARK DROP - , ;                20 SETCLASS IDBR   DXIT DBRA DBHI DBLS DBCC DBCS DBNE DBEQ                         DBVC DBVS DBPL DBMI DBGE DBLT DBGT DBLE      : ISET    400 * 050300 OR CONSTANT    ( ea )                              DOES> @ SRC , ,MORE  ;                                20 SETCLASS ISET   SET SNO SHI SLS SCC SCS SNE SEQ                                 SVC SVS SPL SMI SGE SLT SGT SLE                                                                              \ moves                                               06Jan86gem: MOVE       EXTRA? 7700 AND SRC SZ300 ,                               ,MORE ,EXTRA ;  ( ea ea )                                : MOVEQ      RD SWAP LOW OR 070000 OR , ;  ( n Dn )             : MOVE>USP   RS 047140 OR , ;  ( An )                           : MOVE<USP   RS 047150 OR , ;  ( An )                           : MOVEM>                                                           EXTRA? EAS   044200 OR -SZ1 , , ,EXTRA ;  ( n ea )           : MOVEM<                                                           EXTRA? EAS   046200 OR -SZ1 , , ,EXTRA ;  ( n ea )           : MOVEP      DN? IF    RD SWAP RS OR 410 OR                                      ELSE   RS ROT RD OR 610 OR THEN  -SZ1 2, ;        ( Dm d An ) ( d An Dm )                                      : LMOVE      7700 AND SWAP EAS OR 20000 OR , ;                    ( long reg move )                                                                                                             \ odds and ends                                       06Jan86gem: CMPM   RD SWAP RS OR 130410 OR SZ3 , ;  ( An@+ Am@+ )         : EXG   DN? IF   SWAP DN?  IF  140500 ELSE 140610 THEN >R                   ELSE SWAP DN?  IF  140610 ELSE 140510 THEN >R SWAP              THEN  RS DST R> OR , ;  ( Rn Rm )                   : EXT    RS 044200 OR -SZ1 , ; ( Dn )                           : SWAP   RS 044100 OR , ; ( Dn )                                : STOP   47162 2, ; ( n )                                       : TRAP   17 AND 47100 OR , ; ( n )                              : LINK   RS 047120 OR 2, ; ( n An )                             : UNLK   RS 047130 OR , ; ( An )                                : EOR   EXTRA? EAS DST SZ3 130400 OR , ,EXTRA ;  ( Dn ea )      : CMP   130000 DST SRC SZ3 , ,MORE ;  ( ea Dn )                                                                                                                                                                                                                 \ arithmetic and logic                                06Jan86gem: IBCD   CONSTANT  DOES> @ DST OVER RS OR [ FORTH ] SWAP MS             IF  10 OR  THEN  , ;  ( Dn Dm ) ( An@- Am@- )           140400 IBCD ABCD         100400 IBCD SBCD                       : IDD   CONSTANT  DOES> @ DST OVER RS OR [ FORTH ] SWAP MS              IF  10 OR  THEN  SZ3 , ;  ( Dn Dm ) ( An@- Am@- )       150400 IDD ADDX         110400 IDD SUBX                         : IDEA   CONSTANT  DOES> @ >R DN?  ( ea Dn ) ( Dn ea )              IF  RD SRC R> OR SZ3 , ,MORE                                    ELSE  EXTRA? EAS DST 400 OR R> OR SZ3 , ,EXTRA  THEN ;      150000 IDEA ADD         110000 IDEA SUB                         140000 IDEA AND         100000 IDEA OR                          : IEAD   CONSTANT  DOES> @ DST SRC     , ,MORE ;  ( ea Dn )     040600 IEAD CHK                                                 100300 IEAD DIVU        100700 IEAD DIVS                        140300 IEAD MULU        140700 IEAD MULS                        \ arithmetic and control                              06Jan86gem: IEA    CONSTANT  DOES> @ SRC , ,MORE ;  ( ea )                047200 IEA JSR          047300 IEA JMP                          042300 IEA MOVE>CCR                                             040300 IEA MOVE<SR      043300 IEA MOVE>SR                      044000 IEA NBCD         044100 IEA PEA                          045300 IEA TAS                                                  : IEAS  CONSTANT  DOES> @ SRC SZ3 , ,MORE ;  ( ea )             047200 IEA JSR          047300 IEA JMP                          042300 IEA MOVE>CCR                                             041000 IEAS CLR         043000 IEAS NOT                         042000 IEAS NEG         040000 IEAS NEGX                        045000 IEAS TST                                                 : ICON   CONSTANT  DOES> @  , ;                                 47160 ICON RESET        47161 ICON NOP                          47163 ICON RTE          47165 ICON RTS                          \ structured conditionals  +/- 256 bytes              06Jan86gem: THEN   ?>RESOLVE  ;                                           : IF      , ?>MARK  ;   HEX                                     : ELSE    6000 IF  2SWAP THEN ;                                 : BEGIN   ?<MARK ;                                              : UNTIL   , ?<RESOLVE  ;                                        : AGAIN   6000 UNTIL ;                                          : WHILE   IF ;                                                  : REPEAT  2SWAP AGAIN THEN ;                                    : DO      ?>MARK DROP [ FORTH ] SWAP ;                          : LOOP    DBRA ;                                                6600 CONSTANT 0=   6700 CONSTANT 0<>                            6A00 CONSTANT 0<   6B00 CONSTANT 0>=                            6C00 CONSTANT <    6D00 CONSTANT >=                             6E00 CONSTANT <=   6F00 CONSTANT >                              DECIMAL                                                         \ DEBUGGER                                            06Jan86gem1 2 +THRU                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                       \ Vocabulary,  Range test                       *     26Jun86gemVOCABULARY BUG    BUG ALSO DEFINITIONS                                                                                          VARIABLE <IP     VARIABLE IP>                                   VARIABLE CNT     VARIABLE 'DEBUG                                LABEL FNEXT                                                        IP )+ D7 MOVE   D7 W  LMOVE                                  HERE                                                                W )+ D7 MOVE   D7 A0 LMOVE   A0 ) JMP                       CONSTANT FNEXT1                                                 FORTH DEFINITIONS                                               CODE UNBUG   (S -- )                                              BUG FNEXT ASSEMBLER bank L#) >NEXT bank L#) LONG MOVE           WORD  NEXT  C;                                                BUG DEFINITIONS                                                                                                                 \ Debug version of Next                               30Jun86gemLABEL DEBNEXT   HEX                                                IP D0 MOVE   <IP bank L#) D0 CMP        6500 ( U>= )            IF   IP> bank L#) D0 CMP   6200 ( U<= )                           IF   CNT bank L#) D2 MOVE 1 D2 ADDQ D2 CNT bank L#) MOVE          2 # D2 CMP   0=                                                 IF CNT bank L#) CLR LONG                                           FNEXT bank L#) >NEXT bank L#) MOVE                      WORD      IP SP -) MOVE 'DEBUG bank L#) D7 MOVE   D7 W LMOVE           FNEXT1 bank L#) JMP                                       THEN THEN THEN                                                  FNEXT bank L#) JMP  C;   DECIMAL                             LABEL JBUG                                                         DEBNEXT bank L#) JMP  C;                                     CODE PNEXT                                                         JBUG bank L#) >NEXT bank L#) LONG MOVE WORD  NEXT  C;        \ Load Screen for the MultiTasker                     06Jan86gemONLY FORTH ALSO DEFINITIONS                                        1 2 +THRU    CR .( MultiTasker Low Level Loaded )            ONLY FORTH ALSO DEFINITIONS    EXIT                             The MultiTasker is loaded as an application on top of the       regular Forth System.  There is support for it in the nucleus   in the form of USER variables and PAUSEs inserted inside of     KEY EMIT and BLOCK.  The Forth multitasking scheme is           co-operative instead of interruptive.  All IO operations cause  a PAUSE to occur, and the multitasking loop looks around at     all of the current task for something to do.                                                                                                                                                                                                                                                                                                                                                    \ Multitasking low level                              26Jun86gemCODE (PAUSE)   (S -- )                                            IP SP -) MOVE ( IP to stack )  RP SP -) MOVE ( RP to stack )     UP bank L#) D7 MOVE   D7 A0 LMOVE                               SP A0 )+ MOVE   ( SP to USER area )   2 A0 LONG ADDQ   WORD     A0 ) D7 MOVE  D7 A0 LMOVE   A0 ) JMP  ( to next task) C;     LABEL RESTART     (S -- )                                          SP )+ D7 MOVE ( drop SR ) SP )+ A0 LMOVE  ( return address)     4 A0 SUBQ   A0 UP bank L#) MOVE ( Set UP to new user )          A0 ) D7 MOVE  D7 SP LMOVE  ( Restore stack )                    SP )+ D7 MOVE  D7 RP LMOVE  ( Return stack )                    SP )+ D7 MOVE  D7 IP LMOVE  ( Restore IP )   NEXT   C;                                                                          HEX 4E47 ENTRY !  ( TRAP 7 )   DECIMAL                          ENTRY LINK !  ( only task points to itself )                                                                                 \ Manipulate Tasks                                    06Jan86gemHEX                                                             : LOCAL   (S base addr -- addr' )   UP @ -   +   ;              : @LINK   (S -- addr )   LINK @  ;                              : !LINK   (S addr -- )   LINK !  ;                              : SLEEP   (S addr -- )   4EF8 SWAP ENTRY LOCAL !   ;            : WAKE    (S addr -- )   4E47 SWAP ENTRY LOCAL !   ;            : STOP    (S -- )   UP @ SLEEP   PAUSE   ;                      : SINGLE   (S -- )   ['] PAUSE >BODY ['] PAUSE !   ;            : MULTI    (S -- )                                                 0 9C !   RESTART 9E !                                           ['] (PAUSE) @ ['] PAUSE !   ;                                DECIMAL                                                                                                                                                                                                                                                         \ Load Screen for Machine Dependent IO Words          06Jan86gemONLY FORTH ALSO DEFINITIONS                                        1 1 +THRU    CR .( Machine Dependent IO Words Loaded )       EXIT                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                            \ LC@, LC!, L@, L!, PC@, PC!                          01Jul86gemCODE LC@     (S dadr -- char )                                    SP )+ A0 LMOVE   D0 CLR                                         BYTE   A0 ) D0 MOVE   WORD   D0 SP -) MOVE   NEXT  C;         CODE LC!     (S char dadr -- )                                    SP )+ A0 LMOVE   SP )+ D0 MOVE                                  BYTE   D0 A0 ) MOVE   NEXT C;                                 CODE L@   (S dadr -- n )                                           SP )+ A0 LMOVE   BYTE A0 )+ D0 MOVE   WORD 8 # D0 LSL           BYTE A0 ) D0 MOVE   WORD D0 SP -) MOVE   NEXT END-CODE       CODE L!   (S n dadr -- )                                           SP )+ A0 LMOVE   SP )+ D0 MOVE   BYTE D0 1 A0 D) MOVE           WORD 8 # D0 LSR   BYTE D0 A0 ) MOVE   NEXT END-CODE          HEX   00FF CONSTANT IO-PAGE   DECIMAL                           : PC@   (S port -- byte )   IO-PAGE LC@ ;                       : PC!   (S byte port -- )   IO-PAGE LC! ;                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                       \               The Rest is Silence                   06Jan86gem*************************************************************   *************************************************************   ***                                                       ***   ***    Please direct all questions, comments, and         ***   ***    miscellaneous personal abuse to:                   ***   ***                                                       ***   ***    Henry Laxen          or    Michael Perry           ***   ***    1259 Cornell Avenue        1125 Bancroft Way       ***   ***    Berkeley, California       Berkeley, California    ***   ***    94706                      94702                   ***   ***                                                       ***   *************************************************************   *************************************************************                                                                                                                                   \ Load Screen for 68000 Dependent Code                06Jan86gem                                                                All of the machine dependent code for a particular Forth        implementation is factored out and placed into this file.  For  the 68000 there are 3 different components. The 68k assembler,  the run time debugger, which must have knowledge of how NEXT    is implemented, and the MultiTasker, which uses code words to   WAKE tasks and put them to SLEEP.                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                               \ 68000 Assembler Load Screen                         06Jan86gem                                                                                                                                                                                                NEXT is a macro. It assembles a jump to >NEXT.                    Nearly all CODE words end with NEXT.                                                                                          DOES-OP   is the call opcode compiled by DOES>.                 DOES-SIZE   is the length of the call in bytes.                 DOES?   (S IP -- IP' F )                                          test for DOES> word.  Used by the decompiler.                                                                                 LABEL marks the start of a subroutine whose name returns its      address.                                                      CODE   creates a Forth code word.                                                                                               \ 68000 Assembler                                     06Jan86gem                                                                Deferring the definitions of the commas, marks, and resolves    allows the same assembler to serve for both the system and the   Meta-Compiler.                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                 \ 68000 Assembler                                     06Jan86gemC;  is a synonym for END-CODE                                   ?,  compiles one or two numbers.                                2,  compiles two numbers.                                       OCTAL  is convenient for the bit fields in the 68000.           Many 68000 instructions can operate on either 8, 16, or 32-bit  data. Rather than specify the size individually for each inst-  ruction, the variable SIZE contains the size information for    any instruction which needs it.  Size is set by BYTE, WORD, and LONG.                                                           SZ defines words which select certain bits from SIZE & install  them into the instruction being assmbled. The size field moves  around considerably.                                            LONG?  leaves a flag, true if SIZE is LONG.                     -SZ1  handles an special case where the size field is inverted  with respect to all others. Nice job, Motorola!                 \ Assembler registers and addressing modes.           06Jan86gemNotice that REGS defines several words each time it is used.    MODE defines modifiers which will follow an address register.   Examples:                                                       D0 thru D7 are data registers.                                  A0 thru A7 are address registers.                               D0 A1 ) MOVE   Move contents of D0 to where A1 points.          A7 )+ D1 MOVE   pop item off stack pointed to by A7 into D1.    D2 A6 -) MOVE   push D2 onto stack pointed to by A6.            12 A3 D) CLR   clear address 12 bytes past where A3 points.     34 D3 A4 DI) NEG  negate contents of address at A4+D3+34.       1234 #) JMP jump to absolute address 1234.*NOTE* sign extends!  12.3456 L#) JMP  jump to long absolute address 123456.          56 PCD) D4 MOVE get contents of address at PC+56 into D4.       78 D5 PCDI) NOT complement contents of address at PC+D5+78.     9876 # D6 MOVE  put the value 9876 into D6.                     \ fields and register assignments                     06Jan86gemFIELD defines words which mask off various bit fields.          RS and RD select the source or destination register field.      MS selects the source mode field. EAS selects the source        effective address field. LOW selects the low byte.              DN?   tests for data register mode.                             SRC   merges the source register and mode into the instruction  DST   merges the destination register into the instruction.                                                                     These are the register assgnmnts for the virtual Forth machine  You can refer to the virtual machine registers, for example:    RP )+ SP -) MOVE  pops the top item from the return stack onto  the data stack.                                                 NOTE:   registers A4-A7 and D7 are used, all others are free.    Registers which are used by Forth must be saved and restored    by any routine which uses them.                                \ extended addressing                                 06Jan86gemMany of the 68000's addressing modes require additional bytes   following the opcode.                                           DOUBLE? leaves true if the given mode requires 32 bits of xtra    addressing information.                                       INDEX?  does nothing unless the given mode is an indexed mode,  in which case it packs the extra data into the required format                                                                                                                                                                                                                                                                  MORE?   tests for extra addressing words.                       ,MORE   assembles the extra words.                                                                                                                                                                                                                              \ extended addressing  extras                         06Jan86gemEXTRA   is a temporary storage area for extended addressing       operands.                                                     EXTRA?   tests a mode for extra words. If present, they are       saved in EXTRA to get them out of the way until needed.                                                                                                                                                                                                       ,EXTRA   retrieves the words in EXTRA, if any, and assembles      them.                                                                                                                                                                                                                                                                                                                                                                                                                                                         \ immediates & address register specific              06Jan86gemIMM                                                                defining word for immediate instructions.                                                                                                                                                                                                                    IMMSR                                                             defining word for immediate to ststus register instructions.                                                                                                                                  IQ                                                                 defining word for quick instructions.                                                                                        IEAA                                                               defining word for effective address to address register         instructions.                                                \ shifts, rotates, and bit manipulation               06Jan86gemISR                                                                defining word for shifts and rotates.                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                        IBIT                                                               defining word for bit manipulators.                                                                                                                                                                                                                          \ branch, loop, and set conditionals                  06Jan86gem  There are three classes of conditional instructions: branch,  decrement and branch, and set. In each case there is a four bit field which contains the condition code. This field is the only difference between members of a class. Rather than explicitly   define sixteen words for each class, the word SETCLASS is used  to define all sixteen at once by re-executing the defining word with a different value for the condition code each time. Of the 48 words so defined, only DXIT and SNO are useless.                                                                              Compiler directives like SETCLASS can be very useful. It would be better if there was a way to throw them away after use. I am planning to add a TRANSIENT definitions capability for this and other reasons.                                                                                                                                                                                  \ moves                                               06Jan86gemThese are the MOVE instructions in all their glory.             Notice that I have added LMOVE. This is because the 68k treats  addresses as signed numbers. When a 16 bit address is loaded    into an address register, it is sign-extended. This is never    what I want. Values loaded into data registers is not extended, so I often load 16 bits into a data register, then move all 32  bits into an address register to get an unextended address.     Data register 7 is reserved in this system for this purpose.    LMOVE lets me do the above nonsense without switching between   LONG and WORD sizes constantly.                                 To keep the assembler simple, some words use modified Motorola  mnemonics. HEX FFFF SP -) MOVEM> will save all registers on the stack. ( pronounced MOVEM-OUT ).                                                                                                                                                                \ odds and ends                                       06Jan86gemExamples:                                                       A5 )+ A3 )+ CMPM                                                D0 A3 EXG                                                                                                                                                                                       D2 EXT                                                          D1 SWAP                                                         1234 STOP                                                       3 TRAP                                                          8 A6 LINK                                                       A6 UNLK                                                         D0 A5 ) EOR                                                     A7 )+ D0 CMP                                                                                                                                                                                    \ arithmetic and logic                                06Jan86gemIBCD                                                               defining word for Binary Coded Decimal instructions.                                                                         IDD                                                                defining word for extended instructions.                       e.g. A1 -) A2 -) ADDX     D0 D1 ADDX                          IDEA                                                              defining word for some arithmetic and logical instructions.                                                                                                                                                                                                   IEAD                                                              defining word for some arithmetic and logical instructions.                                                                                                                                   \ arithmetic and control                              06Jan86gemIEA                                                               defining word for instructions which take only an effective     address.                                                                                                                                                                                                                                                      IEAS                                                              defining word for instructions which take only an effective     address, and are affected by SIZE.                                                                                            ICON                                                              defining word for instructions which take no arguments.                                                                                                                                                                                                       \ structured conditionals  +/- 256 bytes              06Jan86gem  These words implement structured conditionals for the         assembler. This is a much cleaner way to express control flow   than the usual technique of random jumps to nonsense labels.    e.g.   D0 D0 OR  0= IF   5 # D1 ADD  ELSE  3 # D1 ADD  THEN            BEGIN  A0 ) D0 MOVE  0<> WHILE  D0 A0 MOVE  REPEAT              5 D3 DO   1 D6 ADDQ   LOOP                                                                                               The last is especially interesting. It will repeat the code     between DO and LOOP 5 times using D3 as a counter.              Note that any DBcc can replace LOOP.                                                                                            IF, WHILE, and UNTIL all expect a branch opcode on the stack.   The most commonly used ones are defined here as constants named for the corresponding condition.                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                \ 16 Bit Subtract Subroutine                          06Jan86gemBUG   The vocabulary that holds the Debugging Words                                                                             <IP  IP>   The range of IP values we are interested in                                                                          FNEXT                                                              A copy of next that gets exeucted instead of the normal one.                                                                                                                                 FNEXT1   Ditto for execute.                                                                                                     UNBUG restores Forth's Next to its original condition.          Effectively disabling tracing.                                                                                                                                                                                                                                  \ Debug version of Next                               06Jan86gem                                                                                                                                DEBNEXT  is the debugger's version of next                      If the IP is between <IP and IP> then the contents of the       execution variable 'DEBUG are executed.  First the IP is pushed onto the parameter stack.  The word pointed to by 'DEBUG can be any high or low level word so long as it discards the IP that   was pushed before it is called, and it must end by calling      PNEXT to patch next once again for more tracing.                                                                                                                                                                                                                PNEXT patches Forth's Next to jump to DEBNEXT.                  This puts us into DEBUG mode and allows for tracing.                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                            \ Multitasking low level                              06Jan86gem(PAUSE)   (S -- )                                                  Puts a task to sleep by storing the IP and the RP on the        parameter stack.  It then saves the pointer to the              parameter stack in the user area and jumps to the code          pointed at by USER+3, switching tasks.                       RESTART     (S -- )                                                Sets the user pointer to point to a new user area and           restores the parameter stack that was previously saved          in the USER area.  Then pops the RP and IP off of the           stack and resumes execution.   The inverse of PAUSE.                                                                         Initialize current User area to a single task.                                                                                                                                                                                                                  \ Manipulate Tasks                                    06Jan86gemLOCAL Map a User variable from the current task to another task @LINK  Return a pointer the the next tasks entry point          !LINK Set the link field of the current task (perhaps relative) SLEEP  makes a task pause indefinitely.                         WAKE  lets a task start again.                                  STOP  makes a task pause indefinitely.                          SINGLE  removes the multi-tasker's scheduler/dispatcher loop.   MULTI                                                             installs the multi-tasker's scheduler/dispatcher loop.          By patching the appropriate INT vector and enabling PAUSE.                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                    \ Machine dependent IO words                          06Jan86gemLC@  get a byte from the 32 bit address on the stack.           LC!  store a byte into the 32 bit address on the stack.                                                                                                                                         PC@    (S port# -- n )                                             Fetch the value at the given input port and push it onto        the stack.                                                   PC!    (S n port# -- )                                             Write the value to the specified port number.